home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue58 / Clinic / RichEditCopying2U.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-19  |  2.7 KB  |  110 lines
  1. unit RichEditCopying2U;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ComCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     reSrc: TRichEdit;
  12.     reDest: TRichEdit;
  13.     Button1: TButton;
  14.     Button2: TButton;
  15.     Label1: TLabel;
  16.     Label2: TLabel;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure Button1Click(Sender: TObject);
  19.     procedure Button2Click(Sender: TObject);
  20.   private
  21.     { Private declarations }
  22.   public
  23.     { Public declarations }
  24.   end;
  25.  
  26. var
  27.   Form1: TForm1;
  28.  
  29. implementation
  30.  
  31. {$R *.DFM}
  32.  
  33. uses
  34.   RichOle, RichEdit, ActiveX, ComObj;
  35.  
  36. procedure TForm1.FormCreate(Sender: TObject);
  37. begin
  38.   reSrc.Lines.LoadFromFile('File.RTF');
  39. end;
  40.  
  41. procedure TForm1.Button1Click(Sender: TObject);
  42. var
  43.   reoSrc, reoDest: IRichEditOle;
  44.   DataObj: IDataObject;
  45.   CharRange: TCharRange;
  46. begin
  47.   //Copies text but not formatting
  48.   //reDest.Lines.Text := reSrc.SelText;
  49.  
  50.   //Copies text and formatting, but uses the clipboard
  51.   //reSrc.CopyToClipboard;
  52.   //reDest.PasteFromClipboard;
  53.  
  54.   //Copies any range, with formatting, and
  55.   //without destroying the clipboard contents
  56.   reSrc.Perform(EM_GETOLEINTERFACE, 0, LParam(@reoSrc));
  57.   if Assigned(reoSrc) then
  58.   begin
  59.     CharRange.cpMin := reSrc.SelStart;
  60.     CharRange.cpMax := reSrc.SelStart + reSrc.SelLength;
  61.     reoSrc.GetClipboardData(CharRange, RECO_COPY, DataObj);
  62.     if Assigned(DataObj) then
  63.     begin
  64.       reDest.Perform(EM_GETOLEINTERFACE, 0, LParam(@reoDest));
  65.       if Assigned(reoDest) then
  66.         reoDest.ImportDataObject(DataObj, 0, 0);
  67.     end
  68.   end
  69. end;
  70.  
  71. procedure TForm1.Button2Click(Sender: TObject);
  72. var
  73.   reoSrc: IRichEditOle;
  74.   DataObj: IDataObject;
  75.   CharRange: TCharRange;
  76.   MSWord: Variant;
  77. const
  78.   wdPasteRTF = 1;
  79. begin
  80.   reSrc.Perform(EM_GETOLEINTERFACE, 0, LParam(@reoSrc));
  81.   if Assigned(reoSrc) then
  82.   begin
  83.     //Select all text
  84.     CharRange.cpMin := 0;
  85.     CharRange.cpMax := -1;
  86.     //Place data object for rich edit content on clipboard
  87.     reoSrc.GetClipboardData(CharRange, RECO_COPY, DataObj);
  88.     OleCheck(OleSetClipboard(DataObj));
  89.     try
  90.       try
  91.         MSWord := GetActiveOleObject('Word.Application');
  92.       except
  93.         MSWord := CreateOleObject('Word.Application');
  94.       end;
  95.       MSWord.Visible := True;
  96.       MSWord.Documents.Add;
  97.       MSWord.Selection.PasteSpecial(DataType := wdPasteRTF)
  98.     finally
  99.       if OleIsCurrentClipboard(DataObj) = S_OK then
  100.         if MessageDlg('Leave RTF data on the clipboard?',
  101.              mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  102.           OleCheck(OleFlushClipboard)
  103.         else
  104.           OleCheck(OleSetClipboard(nil))
  105.     end
  106.   end
  107. end;
  108.  
  109. end.
  110.